home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / util / gnu / gnu_tile_forth.lha / src / float.v < prev    next >
Text File  |  1992-05-19  |  2KB  |  128 lines
  1. /*
  2.   C BASED FORTH-83 MULTI-TASKING KERNEL: FLOATING POINT NUMBERS
  3.  
  4.   Copyright (C) 1990 by Mikael R.K. Patel
  5.  
  6.   Computer Aided Design Laboratory (CADLAB)
  7.   Department of Computer and Information Science
  8.   Linkoping University
  9.   S-581 83 LINKOPING
  10.   SWEDEN
  11.  
  12.   Email: mip@ida.liu.se
  13.  
  14.   Started on: 12 April 1990
  15.  
  16.   Last updated on: 26 June 1990
  17.  
  18.   Dependencies:
  19.     (cc) kernel.c, kernel.h
  20.  
  21.   Description:
  22.     Floating point number extension vocabulary for the tile forth
  23.     multi-tasking kernel.
  24.  
  25.   Copying:
  26.        This program is free software; you can redistribute it and/or modify
  27.        it under the terms of the GNU General Public License as published by
  28.        the Free Software Foundation; either version 1, or (at your option)
  29.        any later version.
  30.  
  31.        This program is distributed in the hope that it will be useful,
  32.        but WITHOUT ANY WARRANTY; without even the implied warranty of
  33.        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  34.        GNU General Public License for more details.
  35.  
  36.        You should have received a copy of the GNU General Public License
  37.        along with this program; see the file COPYING.  If not, write to
  38.        the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 
  39.  
  40. */
  41.  
  42.  
  43. VOID doitof()
  44. {
  45.     coerce(INT32, FLOAT32);
  46. }
  47.  
  48. NORMAL_CODE(itof, forth, "i>f", doitof);
  49.  
  50. VOID doftoi()
  51. {
  52.     coerce(FLOAT32, INT32);
  53. }
  54.  
  55. NORMAL_CODE(ftoi, itof, "f>i", doftoi);
  56.  
  57. VOID dofplus()
  58. {
  59.     binary(+, FLOAT32);
  60. }
  61.  
  62. NORMAL_CODE(fplus, ftoi, "f+", dofplus);
  63.  
  64. VOID dofminus()
  65. {
  66.     binary(-, FLOAT32);
  67. }
  68.  
  69. NORMAL_CODE(fminus, fplus, "f-", dofminus);
  70.  
  71. VOID doftimes()
  72. {
  73.     binary(*, FLOAT32);
  74. }
  75.  
  76. NORMAL_CODE(ftimes, fminus, "f*", doftimes);
  77.  
  78. VOID dofdivide()
  79. {
  80.     binary(/, FLOAT32);
  81. }
  82.  
  83. NORMAL_CODE(fdivide, ftimes, "f/", dofdivide);
  84.  
  85. VOID dofonedivide()
  86. {
  87.    unary(1.0 /, FLOAT32);
  88. }
  89.  
  90. NORMAL_CODE(fonedivide, fdivide, "1/f", dofonedivide);
  91.  
  92. VOID dofnegate()
  93. {
  94.     unary(-, FLOAT32);
  95. }
  96.  
  97. NORMAL_CODE(fnegate, fonedivide, "fnegate", dofnegate);
  98.  
  99. VOID dofdot()
  100. {
  101.     FLOAT32 f;
  102.  
  103.     f = spop(FLOAT32);
  104.     (VOID) fprintf(io_outf, "%g ", f);
  105. }
  106.  
  107. NORMAL_CODE(fdot, fnegate, "f.", dofdot);
  108.  
  109. VOID doqfloat()
  110. {
  111.     FLOAT32 f;
  112.     CHAR c;
  113.  
  114.     doqnumber();
  115.     if (tos.BOOL) return; else sdrop();
  116.  
  117.     if (sscanf(tos.CSTR, "%f%1c", &f, &c) == 1) {
  118.     tos.FLOAT32 = f;
  119.     spush(TRUE, BOOL);
  120.     }
  121.     else {
  122.     spush(FALSE, BOOL);
  123.     }
  124. }
  125.  
  126. NORMAL_CODE(qfloat, fdot, "?float", doqfloat);
  127.  
  128.